;;; A keypad much like a calculator

(defpackage :keypad
  (:use :cl)
  (:nicknames :kp)
  (:export keypad
           simple-keypad
           tiny-keypad
           data
           add-input
           submit
           key-callback
           submit-callback
           target
           read-string
           timer
           cancel-timer
           keypad-input
           keypad-event
           keypad-event-keypad
           keypad-event-value))

(in-package :keypad)

(defvar *width* 35) ; 37

(defclass base-keypad ()
  ((key-callback :initform 'default-callback :initarg :key-callback :accessor key-callback)
   (submit-callback :initarg :submit-callback :accessor submit-callback)
   (target :initarg :target :accessor target)))

(defclass keypad-event (exp:event)
  ((keypad :initform nil :initarg :keypad :accessor keypad-event-keypad)
   (value :initform nil :initarg :value :accessor keypad-event-value)))

(exp:define-event-match keypad-input (state
                                      (event keypad-event)
                                      value)
  (if value-supplied
      (equal value (keypad-event-value event))
      (keypad-event-value event)))

(defun default-callback (keypad string)
  (exp:state-dispatch-event exp:*experiment*
                            (exp:current-state exp:*experiment*)
                            (make-instance 'keypad-event :value string :keypad keypad)))

(gwee:define-component simple-keypad (base-keypad)
  ()
  (:views
   (input gwee:text-area
          :height :maximum
          :width 116
          :border-color gwee:*default-foreground-color*
          :vertical-justification :center
          :left-padding 3)
   (submit gwee:button :data "^" :width *width* :click-callback 'click-submit))
  (:layouts
   (default gwee:column-layout
       (row0)
     :border-color gwee:*default-foreground-color*
     :padding 3)
   (row0 gwee:row-layout (submit input) :padding 3))
  (:default-initargs
      :width 165 :height 35))

(gwee:define-component keypad (base-keypad)
  ()
  (:views
   (input gwee:text-area
          :height :maximum
          :width 110 ; 116
          :border-color gwee:*default-foreground-color*
          :vertical-justification :center
          :left-padding 3)
   (submit gwee:button :data "^" :width *width* :click-callback 'click-submit)
   (b1 gwee:button :data "1" :width *width* :callback-data #\1 :click-callback 'click)
   (b2 gwee:button :data "2" :width *width* :callback-data #\2 :click-callback 'click)
   (b3 gwee:button :data "3" :width *width* :callback-data #\3 :click-callback 'click)
   (b4 gwee:button :data "4" :width *width* :callback-data #\4 :click-callback 'click)
   (b5 gwee:button :data "5" :width *width* :callback-data #\5 :click-callback 'click)
   (b6 gwee:button :data "6" :width *width* :callback-data #\6 :click-callback 'click)
   (b7 gwee:button :data "7" :width *width* :callback-data #\7 :click-callback 'click)
   (b8 gwee:button :data "8" :width *width* :callback-data #\8 :click-callback 'click)
   (b9 gwee:button :data "9" :width *width* :callback-data #\9 :click-callback 'click)
   (b0 gwee:button :data "0" :width *width* :callback-data #\0 :click-callback 'click)
   (b+ gwee:button :data "+" :width *width* :callback-data #\+ :click-callback 'click)
   (b- gwee:button :data (string (code-char 8722)) :width *width* :callback-data #\- :click-callback 'click)
   (b* gwee:button :data (string (code-char 215)) :width *width* :callback-data #\* :click-callback 'click)
   (b/ gwee:button :data (string (code-char 247)) :width *width* :callback-data :divide :click-callback 'click)
   (backspace gwee:button :data (string (code-char 8592)) :width *width* :callback-data #\Backspace :click-callback 'click)
   (bfraction gwee:button :data "/" :width *width* :callback-data #\/ :click-callback 'click))
  (:layouts
   (default gwee:column-layout
       (row0 row1 row2 row3 row4)
     :border-color gwee:*default-foreground-color*
     :margin 4
     :padding 3)
   (row0 gwee:row-layout (submit input) :padding 3)
   (row1 gwee:row-layout (b7 b8 b9 b+) :padding 3)
   (row2 gwee:row-layout (b4 b5 b6 b-) :padding 3)
   (row3 gwee:row-layout (b1 b2 b3 b*) :padding 3)
   (row4 gwee:row-layout (b0 backspace bfraction b/) :padding 3))
  (:default-initargs
      :width 157 :height 140))

(defvar *num-width* 20)

(defclass num (gwee:text-area)
  ((str :initform nil :initarg :string :accessor str))
  (:default-initargs
   :font (gwee:open-font gwee:*default-font-name* 24)
    :width *num-width*
    ;;:foreground (gwee:gray 100 100 255)
    :border-color (gwee:gray 200) ;;gwee:*default-foreground-color*
    :background (gwee:gray 240)
    :border-right nil
    :border-top nil
    :left-padding 1
    :horizontal-justification :center
    :vertical-justification :center))

(defun enter-hook (v x y state)
  (declare (ignore x y state))
  (psetf (gwee:background-color v) gwee:*default-foreground-color*
         (gwee:foreground-color v) (gwee:gray 240);;gwee:*default-background-color*
         (gwee:view-needs-update-p v) t))

(defun leave-hook (v x y state)
  (declare (ignore x y state))
  (psetf (gwee:background-color v) (gwee:gray 240);;gwee:*default-background-color*
         (gwee:foreground-color v) gwee:*default-foreground-color*
         (gwee:view-needs-update-p v) t))

(defmethod shared-initialize :after ((obj num) slot-names &key)
  (gwee:add-hook (gwee:enter-hook obj) 'enter-hook)
  (gwee:add-hook (gwee:leave-hook obj) 'leave-hook))

(defmethod gwee:mouse-press-event ((view num) button x y)
  (let ((comp (gwee:component-for-view view)))
    (when (and (slot-boundp comp 'key-callback)
               (u:funcallable (key-callback comp)))
      (funcall (key-callback comp) comp (or (str view)
                                            (gwee:view-data view))))
    t))

(gwee:define-component tiny-keypad (base-keypad)
  ((timer :initform nil :accessor timer))
  (:views
   (b1 num :data "1" :border-right nil :border-bottom nil)
   (b2 num :data "2" :border-right nil :border-bottom nil)
   (b3 num :data "3" :border-right nil :border-bottom nil)
   (b4 num :data "4")
   (b5 num :data "5")
   (b6 num :data "6")
   (b7 num :data "7")
   (b8 num :data "8")
   (b9 num :data "9")
   (b0 num :data "0" :border-right nil :border-left nil :border-bottom nil)
   (b+ num :data "+" :border-left nil :border-right nil :border-top nil)
   (b- num :data #|"-"|# (string (code-char 8722))
       :string "-"
       :border-left nil :border-right nil :border-top nil)
   (b* num :data "*" ;(string (code-char 215))
       :string "*")
   (b/ num :data (string (code-char 247))
       :string " / ")
   (bfraction num :data "/" :border-right nil :border-top nil)
   (backspace num :data #|"<"|# (string (code-char 8592))
              :wrap-p nil
              :horizontal-offset 2
              :vertical-offset -2
              :horizontal-justification :left
              :vertical-justification :center
              :string :backspace
              :border-right nil :border-bottom nil))
  (:layouts
   (default gwee:row-layout
       (meat)
     :margin 10
     :background nil
     :border-color nil ;gwee:*default-foreground-color*
     :width :minimum :height :minimum)
   (meat gwee:column-layout
       (row1 row2 row3)
     :width :minimum :height :minimum
     :margin 1
     :border-color gwee:*default-foreground-color*) ;(gwee:gray 200))
   (row3 gwee:row-layout (b0 b1 b2 b3  backspace) :width :minimum :height :minimum)
   (row2 gwee:row-layout (b- b4 b5 b6 bfraction) :width :minimum :height :minimum)
   (row1 gwee:row-layout (b+ b7 b8 b9 b*) :width :minimum :height :minimum)
;;    (row4 gwee:row-layout (bfraction))
   )
  (:default-initargs
      :x :current :y :current
      :width :minimum :height :minimum
;;       :width 102 :height 122
      ))
      ;:width 82 :height 102))

(defmethod gwee:mouse-motion-event ((view tiny-keypad) state x y xrel yrel)
  t)

(defun cancel-timer (keypad)
  (when (timer keypad)
    (gwee:cancel-timer (timer keypad))
    (setf (timer keypad) nil)))

(defun add-input (keypad ch)
  (with-slots (input) keypad
    (setf (gwee:view-data input)
          (case ch
            (#\Backspace
             (when (plusp (length (gwee:view-data input)))
               (subseq (gwee:view-data input) 0 (1- (length (gwee:view-data input))))))
            (:divide
             (concatenate 'string (gwee:view-data input) " / "))
            (t (concatenate 'string (gwee:view-data input) (string ch))))
          (gwee:view-needs-update-p input) t)
    (when (and (slot-boundp keypad 'key-callback)
               (u:funcallable (key-callback keypad)))
      (funcall (key-callback keypad) ch))))

(defun click (b)
  (add-input (gwee:component-for-view b) (gwee:callback-data b)))

(defun data (keypad)
  (gwee:view-data (slot-value keypad 'input)))

(defun click-submit (b)
  (let ((keypad (gwee:component-for-view b)))
    (when (submit-callback keypad)
      (let ((s (data keypad)))
        (funcall (submit-callback keypad) s)))))

(defun submit (keypad)
  (click-submit (slot-value keypad 'submit)))

(defun read-string (view x y &rest keys &key block (class 'keypad) &allow-other-keys)
  (remf keys :block)
  (remf keys :class)
  (when block
    (setf (getf keys :submit-callback)
          (lambda (s) (throw 'submit s))))
  (let ((kp (apply 'make-instance class
                   :parent view
                   :x x :y y
                   keys)))
    (setf (gwee:view-needs-update-p kp) t)
    (if block
        (catch 'submit
          (gwee:with-events kp
            (gwee:dispatch-events)))
        kp)))
